home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_9.zip / 10.C < prev    next >
C/C++ Source or Header  |  1993-07-27  |  51KB  |  1,684 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9.  
  10. #include "hdr.h"
  11. #include "libhdr.h"
  12. #include "vars.h"
  13. #include "ifile.h"
  14. #include "chapp.h"
  15. #include "setp.h"
  16. #include "smiscp.h"
  17. #include "miscp.h"
  18. #include "libp.h"
  19. #include "libwp.h"
  20. #include "dclmapp.h"
  21. #include "dbxp.h"
  22. #include "errmsgp.h"
  23.  
  24. int save_trace_opt = 0;
  25. /* chapter 10 */
  26.  
  27. static Tuple context;
  28.  
  29. static void init_compunit();
  30. static void save_comp_info(Node);
  31. static void save_tree(Node, int);
  32. static void renumber_nodes(char *);
  33. static void collect_unit_nodes(Symbol);
  34. static void generic_declarations(Symbol, Unitdecl);
  35. static void save_proper_body_info(Node);
  36. static void save_package_instance_unit(Node);
  37. static void save_subprogram_instance_unit(Node);
  38. static void establish_context(Node);
  39. static void with_clause(Tuple, Node);
  40. static void elaborate_pragma(Node);
  41. static Tuple check_separate(Node);
  42. static Stubenv retrieve_env(Node, Node);
  43. static void remove_obsolete_stubs(char *);
  44. static char *get_unit(char *);
  45. static void new_unit_numbers(Node, unsigned);
  46.  
  47. /*TBSL: need to review calls to sasve_subprog_info now that
  48.  * it has an argument    ds 31 oct
  49.  */
  50.  
  51. extern IFILE *TREFILE, *AISFILE, *LIBFILE;
  52. static Tuple  elab_pragmas;
  53.  
  54. /* all_vis is tuple of unit-names */
  55.  
  56. static void init_compunit()                        /*;init_compunit*/
  57. {
  58.     int    i;
  59.  
  60.     if (cdebug2 > 3) TO_ERRFILE("AT PROC :  init_compunit;");
  61.  
  62.     /* Initialize tree nodes to unit number of the new compilation unit.*/
  63.     unit_number_now = unit_number(unit_name);
  64.     for (i = 1; i <= seq_node_n; i++)
  65.         N_UNIT((Node)seq_node[i]) = unit_number_now;
  66. }
  67.  
  68. void new_compunit(char *typ, Node name_node)    /*;new_compunit*/
  69. {
  70.     char    *name;
  71.  
  72.     if (cdebug2 > 3) TO_ERRFILE("AT PROC :  new_compunit");
  73.  
  74.     name = N_VAL(name_node);
  75.  
  76.     /* Establish global name and library name for new compilation unit. */
  77.     if (IS_COMP_UNIT){
  78.         remove_obsolete_stubs(name);
  79.         seq_symbol_n = 0;     /* reset symbol count */
  80.         unit_name = strjoin(typ, name);
  81.         init_compunit();
  82.     }
  83. }
  84.  
  85. /* chapter 10, part b*/
  86. void compunit(Node node)                            /*;compunit*/
  87. {
  88.     Node    unit_body;
  89.     Tuple    added_names;
  90.     char    *id;
  91.     Fortup    ft1;
  92.     Symbol    sym;
  93.     Fordeclared fd;
  94.  
  95.     if (cdebug2 > 3) TO_ERRFILE("AT PROC :  compunit;");
  96.  
  97.     elab_pragmas = tup_new(0);
  98.     stubs_to_write = set_new(0);
  99.     all_vis = tup_new(0);
  100.     /*context_node = N_AST1(node);*/
  101.     unit_body = N_AST2(node);
  102.     establish_context(node);
  103.     /* process unit only if there were no problems in processing context */
  104.     if (context != (Tuple)0)
  105.         adasem(unit_body);
  106.     if (errors == 0) {
  107.         /* If there are no errors in any comp unit in the file, collect global
  108.          * maps and library information after completion of this a compilation
  109.          * unit.
  110.          */
  111.         if (N_KIND(unit_body) == as_separate)
  112.             /* collect symbol table information for body (it is not a unit, 
  113.              * and must be saved explicitly here).
  114.              */
  115.             save_proper_body_info(unit_body);
  116.  
  117.         tup_frome(newtypes);
  118.  
  119.         if (N_KIND(unit_body) == as_insert) {
  120.             if (N_KIND(N_AST1(unit_body)) == as_subprogram_tr)
  121.                 /* for a subprogram instance, we place renaming code in the body
  122.                  * of the subprogram. If there is some additional instantiation 
  123.                  * code (bounds checks, etc.) it must be placed in a separate
  124.                  * unit on which the instantiation depends.
  125.                  */
  126.                 save_subprogram_instance_unit(node);
  127.             else
  128.                 /* Produce two units, one for spec instance and one for body. */
  129.                 save_package_instance_unit(node);
  130.         }
  131.         else {        /* any other kind of compilation unit.*/
  132.             save_comp_info(node);
  133.         }
  134.     }
  135.     /* Reinitialize compilation environment. */
  136.  
  137.     unit_name = strjoin("","");
  138.     newtypes = tup_with(newtypes, (char *) tup_new(0));
  139.     /*   DECLARED := BASE_DECLARED;
  140.      * Delete symbols placed in standard0 by previous compilation,
  141.      * restoring standard0 to its initial state. added_names is a tuple
  142.      * of identifiers added in prior compilation.
  143.      */
  144.     added_names = tup_new(0); /* build tuple of added identifiers */
  145.     FORDECLARED(id, sym, DECLARED(symbol_standard0), fd);
  146.         if (sym != (Symbol)0 && S_UNIT(sym))
  147.             added_names = tup_with(added_names, id);
  148.     ENDFORDECLARED(fd);
  149.     FORTUP(id=(char *), added_names, ft1);
  150.         dcl_undef(DECLARED(symbol_standard0), id);
  151.     ENDFORTUP(ft1);
  152.     tup_free(added_names);
  153.  
  154.     DECLARED(symbol_unmentionable) = base_declared[1];
  155.     DECLARED(symbol_standard) = base_declared[2];
  156.     DECLARED(symbol_ascii) = base_declared[3];
  157.     FORDECLARED(id, sym, DECLARED(symbol_ascii), fd);
  158.         IS_VISIBLE(fd) = TRUE;
  159.     ENDFORDECLARED(fd);
  160.     scope_name = symbol_standard0;
  161.     open_scopes = tup_new(2);
  162.     open_scopes[1] = (char *)symbol_standard0;
  163.     open_scopes[2] = (char *)symbol_unmentionable;
  164.     used_mods = tup_new(0);
  165.     vis_mods = tup_new1((char *) symbol_ascii);
  166.     scope_st = tup_new(0);
  167.     return;
  168. }
  169.  
  170. static void save_comp_info(Node node)                    /*;save_comp_info*/
  171. {
  172.     /* Subsidiary to the previous procedure. In the case of a unit which is
  173.      * a package instantiation, the current procedure is called twice, to
  174.      * produce separate units for the instance spec and the instance body.
  175.      */
  176.  
  177.     Unitdecl    ud;
  178.     char    *v;
  179.     Tuple    tup;
  180.     Set        vis_units;
  181.     int        uindex, i, si;
  182.     struct unit *pUnit;
  183.     Fortup    ft1;
  184.     Forset    fs1;
  185.     Stubenv    ev;
  186.     char    *stub_name;
  187.  
  188.     vis_units = set_new(tup_size(all_vis));
  189.  
  190.     uindex = unit_number(unit_name);
  191.     pUnit = pUnits[uindex];
  192.     /*PRE_COMP(unit_name) := vis_units;*/
  193.     FORTUP(v=(char *), all_vis, ft1);
  194.         vis_units = set_with(vis_units, (char *) unit_numbered(v));
  195.     ENDFORTUP(ft1);
  196.     pUnit->aisInfo.preComp = (char *)vis_units;
  197.     pUnit->aisInfo.pragmaElab = (char *) tup_copy(elab_pragmas);
  198.  
  199.     /* Before writing out any info, set unit of all symbols allocated
  200.      * while compiling this unit to current unit number
  201.      */
  202.     for (i = 1; i <= seq_symbol_n; i++)
  203.         S_UNIT((Symbol)seq_symbol[i]) = uindex;
  204.  
  205.     save_tree(node, uindex);
  206.     update_lib_maps(unit_name, 'u');
  207.     pUnit->aisInfo.compDate = (char *) tup_new(0);
  208.  
  209.     /*UNIT_DECL(unit_name) +:= [CONTEXT, UNIT_NODES];    */
  210.     ud = unit_decl_get(unit_name);
  211.     if (ud == (Unitdecl)0)
  212.         chaos("save_comp_info: unit decl missing");
  213.     ud->ud_context = tup_copy(context);
  214.     ud->ud_nodes = tup_copy(unit_nodes);
  215.     unit_decl_put(unit_name, ud);
  216.     if (!errors) {
  217.         /* Stub environment info is now written after the tree nodes
  218.          * are renumbered in save_tree. Also in case of erros Stub info
  219.          * is not written to st1 file.
  220.          */
  221.         FORSET(si=(int), stubs_to_write, fs1)
  222.             stub_name = lib_stub[si];
  223.             tup = (Tuple) stub_info[si];
  224.             ev = (Stubenv) tup[2];
  225.             write_stub(ev, stub_name, "st1");
  226.         ENDFORSET(fs1);
  227.     }
  228.     if (!errors) write_ais(uindex);
  229. }
  230.  
  231. static void new_unit_numbers(Node root, unsigned newUnitNumber)
  232.                                                         /*;new_unit_number*/
  233. {
  234.     unsigned nodeKind;
  235.     Node listNode;
  236.     Fortup ft1;
  237.     Tuple listTuple;
  238.  
  239.     if (root == (Node)0 || root == OPT_NODE) return;
  240.     N_UNIT(root) = newUnitNumber;
  241.  
  242.     nodeKind = N_KIND(root);
  243.     if (N_AST1_DEFINED(nodeKind)) new_unit_numbers(N_AST1(root), newUnitNumber);
  244.     if (N_AST2_DEFINED(nodeKind)) new_unit_numbers(N_AST2(root), newUnitNumber);
  245.     if (N_AST3_DEFINED(nodeKind)) new_unit_numbers(N_AST3(root), newUnitNumber);
  246.     if (N_AST4_DEFINED(nodeKind)) new_unit_numbers(N_AST4(root), newUnitNumber);
  247.  
  248.     if (! N_LIST_DEFINED(nodeKind)) return;
  249.  
  250.     listTuple = N_LIST(root);
  251.     FORTUP(listNode=(Node), listTuple, ft1);
  252.         new_unit_numbers(listNode, newUnitNumber);
  253.     ENDFORTUP(ft1);
  254. }
  255.  
  256. static void save_tree(Node root, int uindex)        /*;save_tree*/
  257. {
  258.     /* This procedure builds a sequential list of all the nodes in the
  259.      * abstract syntax tree while performing a preorder scan of the tree.
  260.      * For a given node, all its components are  placed in a flat tuple
  261.      * "tree_node".     This tuple is then added to the list.
  262.      *
  263.      * For the C version, we need to traverse the tree to find the reachable
  264.      * nodes, which are built up in a string reach such that reach[i] is
  265.      * 1 if node with sequence number i is reachable, 0 otherwise.
  266.      * We then call write_tree (lib.c)  to actually write the tree.
  267.      */
  268.  
  269.     int    stack_max, stack_now, na, i, unit_now, nk;
  270.     Tuple    stack, a;
  271.     Node    nodes[5], n, nod;
  272.     char    *reach;
  273. #define STACK_INC 50
  274.  
  275.     if (TREFILE == (IFILE *)0) return;
  276.     reach = emalloct((unsigne